Analysis for Neginhib (Ann Nordmeyer, Erica Yoon, Mike Frank). The study included three games designed to test the relationship between inhibitory control, implicature processing, and negation processing. All games had a similar structure: participants saw two pictures and heard a word, and had to select the picture that goes with the word as quickly as possible. Each game had two trial types, labeled control and target in these analyses. The three games were:

Inhibition Game : Participants saw several identical trials in a row (e.g. the word “apple” with pictures of an apple and a cookie) and then saw a trial with the same pictures but a different word (e.g. “cookie” with pictures of an apple and a cookie). The repeated trials in each run are the control trials and the final trial in each run was the target trial, designed to measure inhibitory control.

Implicature Game: On control / unambiguous trials, participants saw two single pictures (e.g. a picture of an apple and a picture of a cookie) and heard a word referring to one of the pictures (e.g. “apple”). On target / implicatures trials, participants saw a picture with a single item and a picture with the same item paired with another item (e.g. a picture of an apple, and a picture of an apple and a cookie) and heard e.g. “apple”. The “correct” response on these trials is the response generated by the ad-hoc implicature, e.g. that “apple” must refer to the single apple because otherwise the speaker would have said “cookie”.

Negation Game: On control / positive trials, participants saw two pictures and heard a word referring to one of the pictures (e.g. a picture of an apple and a picture of a cookie, with the word “apple”). On target / negative trials, participants saw two pictures and heard a word negating one of the pictures (e.g. a picture of an apple and a picture of a cookie, with the words “no apple”).

Kids played these games at the CDM on a computer (4, 5, and 6-year-olds), with 60 trials per game. Adults completed the task on MTurk, with 120 trials per game. The adult version of the task can be viewed here: https://langcog.stanford.edu/expts/EJY/neginhib/v1/turk/neginhib_mturk.html

Setting up

Load required Libraries

rm(list=ls())
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.2.3
library(dplyr)
## 
## Attaching package: 'dplyr'
## 
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## 
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(tidyr)
library(magrittr)
## 
## Attaching package: 'magrittr'
## 
## The following object is masked from 'package:tidyr':
## 
##     extract
library(RWiener)
library(knitr)
library(bootstrap)
library(gridExtra)
library(effsize)
library(lme4)
## Loading required package: Matrix
## 
## Attaching package: 'Matrix'
## 
## The following object is masked from 'package:tidyr':
## 
##     expand
library(GGally)
## Warning: package 'GGally' was built under R version 3.2.3
## 
## Attaching package: 'GGally'
## 
## The following object is masked from 'package:dplyr':
## 
##     nasa

Some useful functions:

# number of unique subs
n.unique <- function (x) {
  length(unique(x))
}

# for bootstrapping 95% confidence intervals
theta <- function(x,xdata) {mean(xdata[x])}
ci.low <- function(x) {
  quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.025)}
ci.high <- function(x) {
  quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.975)}

Load in data

RT trimming:

d.turk <- read.csv("../long_data/long_data_mturk.csv") 
n.turk.initial <- n.unique(d.turk$subid)

d.turk <- d.turk %>%
  # remove anyone who played fewer than 300 trials (means they did not complete at least half of the third game) or over 408 trials (means they completed the task twice, because 408 is max number of trials -- this only happened for one participant and I'm not sure how they were able to do this, so I'm rejecting them)
  mutate(subid = factor(subid)) %>%
  group_by(subid) %>%
  mutate(ntrials = n()) %>%
  filter(ntrials > 300 & ntrials < 408) %>%
  ungroup() %>%
  # create resp and rt vars
  mutate(resp = factor(response, levels=c("Y","N"), labels=c("upper","lower")), 
         q = rt/1000) %>%
  # remove outlier RTs
  filter(rt > 200, 
         rt < 15000) %>% # filtering the mysterious neg rt...
  filter(log(rt) < mean(log(rt)) + 3 * sd(log(rt)), 
         log(rt) > mean(log(rt)) - 3 * sd(log(rt))) %>%
  # clean up
  select(subid, game, trial.num, trial.type, q, resp) %>%
  mutate(agegroup = "adults") %>%
  ungroup() 
n.turk.final <- n.unique(d.turk$subid)

d.cdm.raw <- read.csv("../long_data/long_data_cdm.csv") %>%
  filter(agegroup == 4 | agegroup == 5 | agegroup == 6) 
n.cdm.initial <- n.unique(d.cdm.raw$subid)

d.cdm <- d.cdm.raw %>%
  # remove any child who played fewer than 150 trials (means they didn't complete at least half of the final game)
  group_by(subid) %>%
  mutate(ntrials = n()) %>%
  filter(ntrials > 150) %>%
  ungroup() %>%
  group_by(agegroup) %>% #Note: doing rt trimming within age group for this sample
  # create resp and rt vars
  mutate(resp = factor(response, levels=c("Y","N"), labels=c("upper","lower")), 
         q = rt/1000) %>%
  # remove outlier RTs
  filter(rt > 200,
         rt < 15000) %>% # filtering the mysterious neg rt...
  filter(log(rt) < mean(log(rt)) + 3 * sd(log(rt)), 
         log(rt) > mean(log(rt)) - 3 * sd(log(rt))) %>%
  ungroup() 
m_age_comp <- aggregate(age ~ agegroup, d.cdm, mean)
min_age_comp <- aggregate(age ~ agegroup, d.cdm, min)
max_age_comp <- aggregate(age ~ agegroup, d.cdm, max)

d.cdm <- d.cdm %>%
  # clean up
  select(subid, age, agegroup, game, trial.num, trial.type, q, resp) %>%
  mutate(agegroup = factor(agegroup)) %>%
  ungroup() 
n.cdm.final <- n.unique(d.cdm$subid)
ns.cdm <- aggregate(subid ~ agegroup, d.cdm, n.unique)

d <- bind_rows(d.turk, d.cdm)

d$subid <- factor(d$subid)

d$agegroup <- factor(d$agegroup, levels = c("adults", "4", "5", "6"))

d$trial.labels <- factor(d$trial.type, levels = c("control", "inhib", "unambiguous", "implicature", "positive", "negative"))

d$correct <- as.numeric(as.character(factor(d$resp, 
                                            levels=c("upper","lower"), 
                                            labels=c("1","0"))))==1

d$trial.type <- factor(d$trial.type %in% c("inhib","implicature","negative"), 
                       levels = c(FALSE, TRUE), 
                       labels = c("control","target"))

d$game <- factor(d$game, levels=c("inhibition","implicature","negation"))

d <- d %>%
  mutate(agegroup2 = ifelse(agegroup == "adults", "adults", "kids"))

We excluded 2 adult participants and 24 child participants for failing to complete at least half of the trials in each game. This left a final sample of 48 adult participants and 66 child participants (22 4-year-olds (age range 4.01-4.99, mean age = 4.6), 19 5-year-olds (age range 5.03-5.95, mean age = 5.49), and 25 6-year-olds (age range 6-6.99, mean age = 6.46)).

Initial analysis

Proportion Correct

Proportion correct:

ms.acc <- d %>%
  group_by(game, trial.type, subid, agegroup) %>%
  summarise(m = mean(correct)) %>%
  group_by(game, trial.type, agegroup) %>%
  summarise(cih = ci.high(m),
            cil = ci.low(m),
            m = mean(m)) 
ms.acc$agegroup <- factor(ms.acc$agegroup, 
                      levels = c("4", "5", "6", "adults"), 
                      labels =  c("4", "5", "6", "Adults"))
ms.acc$trial.type <- factor(ms.acc$trial.type, labels = c("Control", "Target"))
ms.acc$game <- factor(ms.acc$game, labels = c("Inhibition", "Implicature", "Negation"))
ms.acc$kid <- ms.acc$agegroup != "Adults"

qplot(data = ms.acc, x = agegroup, y = m, color = trial.type, 
      geom = "point", position = position_dodge(.2)) + 
  geom_errorbar(aes(ymin = cil, ymax = cih), 
                position = position_dodge(.2), width = 0) + 
  geom_line(aes(group = interaction(kid,trial.type), col = trial.type)) + 
  facet_grid( ~ game) +
  ylab("Proportion correct") + xlab("Age Group") +
  scale_color_hue(name = "Trial Type") +
  theme_bw()

So kids are much less accurate than adults on target trials, especially in the implicature and negation games. In general, both adults and kids have lower accuracy on target trials. It looks children show some improvement on the implicatures game across development but maybe not so much improvement across development on the negation game?

Do kids differ from adults in accuracy?

##Inhibition: 
correct.inhib <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "inhibition"), 
                             family = "binomial")
kable(summary(correct.inhib)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 4.490 0.190 23.615 0.000
trial.typetarget -2.096 0.202 -10.381 0.000
agegroup2kids -1.450 0.236 -6.137 0.000
trial.typetarget:agegroup2kids 0.629 0.247 2.545 0.011 
##Implicature:
correct.imp <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "implicature"),
                             family = "binomial")
kable(summary(correct.imp)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.369 0.156 21.657 0.000
trial.typetarget -1.145 0.213 -5.384 0.000
agegroup2kids -0.949 0.196 -4.852 0.000
trial.typetarget:agegroup2kids 0.122 0.273 0.448 0.654 
##Negation: 
correct.neg <- glmer(correct ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "negation"), 
                             family = "binomial")
kable(summary(correct.neg)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.746 0.158 17.379 0.000
trial.typetarget -0.179 0.279 -0.643 0.520
agegroup2kids 0.190 0.220 0.863 0.388
trial.typetarget:agegroup2kids -1.984 0.375 -5.296 0.000

Is there developmental change from 4 to 6 years?

##Inhibition: 
correct.inhib.kids <- glmer(correct ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "inhibition",
                                           agegroup != "adults"), 
                             family = "binomial")
kable(summary(correct.inhib.kids)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.038 0.984 0.039 0.969
trial.typetarget 2.311 1.002 2.306 0.021
age 0.549 0.177 3.096 0.002
trial.typetarget:age -0.700 0.179 -3.905 0.000 
##Implicature:
correct.imp.kids <- glmer(correct ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "implicature",
                                           agegroup != "adults"), 
                             family = "binomial")
kable(summary(correct.imp.kids)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 0.597 0.797 0.749 0.454
trial.typetarget -0.368 1.227 -0.300 0.764
age 0.329 0.143 2.299 0.021
trial.typetarget:age -0.119 0.219 -0.542 0.588 
##Negation: 
correct.neg.kids <- glmer(correct ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "negation",
                                           agegroup != "adults"), 
                             family = "binomial")
kable(summary(correct.neg.kids)$coefficients, digits = 3)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 2.679 1.230 2.177 0.029
trial.typetarget -2.467 2.226 -1.109 0.268
age 0.071 0.217 0.327 0.744
trial.typetarget:age 0.030 0.395 0.075 0.940

Reaction time

What about reaction time? Here we just look at RTs on correct trials (outlier RTs were trimmed earlier when the data was loaded).

#Plot data
ms.rt <- d %>%
  filter(correct == TRUE) %>%
  group_by(game, trial.type, subid, agegroup) %>%
  summarise(m = mean(q)) %>%
  group_by(game, trial.type, agegroup) %>%
  summarise(cih = ci.high(m),
            cil = ci.low(m),
            m = mean(m)) 
ms.rt$agegroup <- factor(ms.rt$agegroup, 
                      levels = c("4", "5", "6", "adults"), 
                      labels = c("4", "5", "6", "Adults"))
ms.rt$game <- factor(ms.rt$game, labels = c("Inhibition", "Implicature", "Negation"))
ms.rt$trial.type <- factor(ms.rt$trial.type, labels = c("Control", "Target"))

ms.rt$kid <- ms.rt$agegroup != "Adults"
qplot(data = ms.rt, x = agegroup, y = m, color = trial.type, 
      geom = "point", position = position_dodge(.2)) + 
  geom_errorbar(aes(ymin = cil, ymax = cih), 
                position = position_dodge(.2), width = 0) + 
  geom_line(aes(group = interaction(kid,trial.type), col = trial.type)) + 
  facet_grid( ~ game) +
  ylab("RT (s)") + xlab("Age Group") +
  scale_color_hue(name = "Trial Type") +
  theme_bw()

Are kids significantly slower than adults?

##Inhibition: 
rt.inhib <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "inhibition",
                                           correct == TRUE))
kable(summary(rt.inhib)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 0.641 0.034 18.906
trial.typetarget 0.140 0.014 9.709
agegroup2kids 0.628 0.045 14.011
trial.typetarget:agegroup2kids 0.094 0.023 4.056 
##Implicature:
rt.imp <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "implicature",
                                           correct == TRUE))
kable(summary(rt.imp)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 0.933 0.050 18.590
trial.typetarget -0.011 0.029 -0.400
agegroup2kids 0.933 0.067 14.022
trial.typetarget:agegroup2kids -0.026 0.040 -0.637 
##Negation: 
rt.neg <- lmer(q ~ trial.type * agegroup2 + (trial.type | subid), 
                             data = filter(d, game == "negation",
                                           correct == TRUE))
kable(summary(rt.neg)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 0.952 0.041 23.485
trial.typetarget 0.009 0.027 0.325
agegroup2kids 0.686 0.054 12.721
trial.typetarget:agegroup2kids 0.148 0.040 3.715

Do kids RTs change developmentally?

##Inhibition: 
rt.inhib.kids <- lmer(q ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "inhibition",
                                           agegroup != "adults", 
                                           correct == TRUE))
kable(summary(rt.inhib.kids)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 2.432 0.203 11.951
trial.typetarget 0.023 0.187 0.124
age -0.209 0.036 -5.775
trial.typetarget:age 0.038 0.033 1.139 
##Implicature:
rt.imp.kids <- lmer(q ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "implicature",
                                           agegroup != "adults", 
                                           correct == TRUE))
kable(summary(rt.imp.kids)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 3.307 0.328 10.088
trial.typetarget -0.248 0.261 -0.949
age -0.259 0.058 -4.442
trial.typetarget:age 0.037 0.046 0.807 
##Negation: 
rt.neg.kids <- lmer(q ~ trial.type * age + (trial.type | subid), 
                             data = filter(d, game == "negation",
                                           agegroup != "adults", 
                                           correct == TRUE))
kable(summary(rt.neg.kids)$coefficients, digits = 3)
Estimate Std. Error t value
(Intercept) 3.005 0.245 12.255
trial.typetarget 0.687 0.251 2.733
age -0.246 0.044 -5.638
trial.typetarget:age -0.095 0.044 -2.132

So it looks like for both adults and children there is only an effect of trial type (e.g. control vs. target) on the inhibition game, where both adults and children were slower on the target trials. Older children are faster than younger children, on all games.

Individual Differences

Is there any correlation between an individual’s performance on one game vs. another game?

ms.acc.kids <- d %>%
  filter(agegroup2 == "kids") %>%
  group_by(subid, game, trial.type) %>%
  summarise(correct = mean(correct)) %>%
  spread(trial.type, correct) %>%
  mutate(sdiff = scale(target - control)) %>%
  select(-control, -target) %>%
  spread(game, sdiff)

ms.acc.adults <- d %>%
  filter(agegroup2 == "adults") %>%
  group_by(subid, game, trial.type) %>%
  summarise(correct = mean(correct)) %>%
  spread(trial.type, correct) %>%
  mutate(sdiff = scale(target - control)) %>%
  select(-control, -target) %>%
  spread(game, sdiff)

ms.rt.kids <- d %>%
  filter(correct == TRUE, agegroup2 == "kids") %>%
  group_by(subid, game, trial.type) %>%
  summarise(rt = mean(q)) %>%
  spread(trial.type, rt) %>%
  mutate(sdiff = scale(target - control)) %>%
  select(-control, -target) %>%
  spread(game, sdiff)

ms.rt.adults <- d %>%
  filter(correct == TRUE, agegroup2 == "adults") %>%
  group_by(subid, game, trial.type) %>%
  summarise(rt = mean(q)) %>%
  spread(trial.type, rt) %>%
  mutate(sdiff = scale(target - control)) %>%
  select(-control, -target) %>%
  spread(game, sdiff)

First let’s look at individual differences in accuracy for adults:

ggpairs(data = ms.acc.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

inhibimp_accadults <- cor.test(ms.acc.adults$inhibition, ms.acc.adults$implicature)
inhibneg_accadults <- cor.test(ms.acc.adults$inhibition, ms.acc.adults$negation)
negimp_accadults <- cor.test(ms.acc.adults$negation, ms.acc.adults$implicature)

There is no significant correlation between inhibition and implicature accuracy (r = 0.21, p = 0.16) or inhibition and negation accuracy (r = -0.11, p = 0.46).

What about for kids’ accuracy?

ggpairs(data = ms.acc.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

inhibimp_acckids <- cor.test(ms.acc.kids$inhibition, ms.acc.kids$implicature)
inhibneg_acckids <- cor.test(ms.acc.kids$inhibition, ms.acc.kids$negation)
negimp_acckids <- cor.test(ms.acc.kids$negation, ms.acc.kids$implicature)

There is no significant correlation between inhibition and implicature accuracy (r = -0.07, p = 0.55) or inhibition and negation accuracy (r = 0.09, p = 0.5).

Now let’s look at individual differences in reaction time for adults:

ggpairs(data = ms.rt.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

inhibimp_rtadults <- cor.test(ms.rt.adults$inhibition, ms.rt.adults$implicature)
inhibneg_rtadults <- cor.test(ms.rt.adults$inhibition, ms.rt.adults$negation)
negimp_rtadults <- cor.test(ms.rt.adults$negation, ms.rt.adults$implicature)

There is no significant correlation between inhibition and implicature reaction time (r = 0.04, p = 0.77) or inhibition and negation reaction time (r = 0.13, p = 0.36).

There is a small marginally significant correlation between adults’ RT on the negation game and the implicature game (r = 0.29, p = 0.05).

What about kids’ RT?

ggpairs(data = ms.rt.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

inhibimp_rtkids <- cor.test(ms.rt.kids$inhibition, ms.rt.kids$implicature)
inhibneg_rtkids <- cor.test(ms.rt.kids$inhibition, ms.rt.kids$negation)
negimp_rtkids <- cor.test(ms.rt.kids$negation, ms.rt.kids$implicature)

There is no significant correlation between inhibition and implicature reaction time (r = 0.17, p = 0.18) or inhibition and negation reaction time (r = -0.01, p = 0.95).

Diffusion Analysis

For the diffusion analysis, we estimated parameters separately for each trial type within each game. Parameters are estimated within each subject and then we aggregate across subjects to get means & confidence intervals on the parameters.

Plot densities

Plots show density of RTs for correct (pink) and incorrect responses (green), for each trial type. You can kind of see the speed-accuracy tradeoff in some of these plots, especially the inhibition trials.

#Make a bunch of plots:
ggplot(d, aes(x = q)) + 
  geom_density(aes(group = resp, colour = resp, fill = resp), alpha = 0.3) +
  facet_grid(agegroup ~ game + trial.type, scales = "free") + 
  scale_fill_hue(labels = c("incorrect", "correct")) +
  scale_color_hue(labels = c("incorrect", "correct")) +
  theme_bw()

Estimating parameters

We calculated parameters for each trial type separately, within each subject. Then we aggregated across subjects to get means & confidence intervals on the parameters, and plotted the parameters across each game & trial type.

sub.pars <- data.frame(Separation = numeric(),
                       Non.Decision = numeric(),
                       Bias = numeric(),
                       Drift = numeric(),
                       Trial.Type = character(),
                       SubID = character(), 
                       Age = character())
sub.pars$Trial.Type <- as.character(sub.pars$Trial.Type)
sub.pars$SubID <- as.character(sub.pars$SubID)
sub.pars$Age <- as.character(sub.pars$Age)

temp.pars <- sub.pars

#because RWiener is finicky:
d$resp <- as.character(d$resp)
trialtypes <- c("control", "inhib", "unambiguous", "implicature", "positive", "negative")
subs <- unique(d$subid)

for (j in 1:length(subs)) {
  sid <- as.character(subs[j]) 
  for (i in 1:length(trialtypes)) {
    ttype <- as.character(trialtypes[i])
    dat <- as.data.frame(subset(d, trial.labels == ttype & subid == sid))
    opt <- optim(c(1, .1, .1, 1), wiener_deviance, 
                 dat=select(dat, c(q, resp)), method="Nelder-Mead")
    pars <- c(opt$par, ttype, sid, as.character(dat$agegroup[1]))
    temp.pars[i,] <- pars
  }
  sub.pars <- rbind(temp.pars, sub.pars)
  temp.pars <- temp.pars[0, ]
}

Plot Parameters:

This plot shows the mean parameter values & 95% C.I.s for each game/trial type.

sub.pars <- sub.pars %>%
  mutate(Condition = ifelse(Trial.Type == "control" | Trial.Type == "positive" | Trial.Type == "unambiguous", "Control", "Target"),
         Game = ifelse(Trial.Type == "control" | Trial.Type == "inhib", "inhibition", ifelse(Trial.Type == "positive" | Trial.Type == "negative", "negation", "implicature")))

sub.pars$Separation <- as.numeric(sub.pars$Separation)
sub.pars$Non.Decision <- as.numeric(sub.pars$Non.Decision)
sub.pars$Bias <- as.numeric(sub.pars$Bias)
sub.pars$Drift <- as.numeric(sub.pars$Drift)
sub.pars$Kids <- sub.pars$Age != "adults"

sub.pars <- sub.pars %>% 
  group_by(Game, Kids) %>%
  filter(Separation < mean(Separation) + 3 * sd(Separation), 
         Separation > mean(Separation) - 3 * sd(Separation)) %>%
  filter(Non.Decision < mean(Non.Decision) + 3 * sd(Non.Decision), 
         Non.Decision > mean(Non.Decision) - 3 * sd(Non.Decision)) %>%
  filter(Bias < mean(Bias) + 3 * sd(Bias), 
         Bias > mean(Bias) - 3 * sd(Bias)) %>%
  filter(Drift < mean(Drift) + 3 * sd(Drift), 
         Drift > mean(Drift) - 3 * sd(Drift)) %>%
  ungroup() %>%
  na.omit()

sub.pars.ms <- sub.pars %>%
  gather(Param, Value, Separation:Drift) %>%
  group_by(Age, Condition, Game, Param) %>%
  summarise(M = mean(Value),
            cih = ci.high(Value),
            cil = ci.low(Value))
sub.pars.ms$Game <- factor(sub.pars.ms$Game, levels = c("inhibition", "implicature", "negation"))

qplot(data = filter(sub.pars.ms), x = Age, color = Condition,
      y = M, ymax=cih, ymin=cil, 
      geom = "pointrange", position = position_dodge(.25)) +
  facet_grid(Param ~ Game, scales = "free") +
  theme_bw()

Plot diffusion process:

We can also take these parameters and visualize the actual diffusion process for each game/trial type/age group:

#Visualize diffusion process for each game & trial type

games <- c("inhibition", "implicature", "negation")
age <- unique(sub.pars.ms$Age)
p <- list()

#graph axes
x <- 2
y <- 4

for (a in 1:length(age)) {
    for (g in 1:length(games)) {
    params <- sub.pars.ms %>%
      subset(Game == games[g] & Age == age[a]) %>%
      gather(Name, Value, M:cil) %>%
      unite(Stats, Param, Name) %>%
      spread(Stats, Value)
    params$yint_M = (params$Bias_M*params$Separation_M) - (params$Drift_M*params$Non.Decision_M)
    params$yint_cih = (params$Bias_M*params$Separation_M) - (params$Drift_cih*params$Non.Decision_M)
    params$yint_cil = (params$Bias_M*params$Separation_M) - (params$Drift_cil*params$Non.Decision_M)
    
    drift_ribbon <- data.frame(xvals = c(params$Non.Decision_M, #non-decision time
                                         (params$Separation_M - params$yint_cih) / params$Drift_cih, #Point where high drift line hits separation boundary
                                         (params$Separation_M - params$yint_M) / params$Drift_M, #Point where drift line hits separation boundary
                                         ifelse(params$Drift_cil > 0, (params$Separation_M - params$yint_cil) / params$Drift_cil, (0 - params$yint_cil) / params$Drift_cil)), #Point where low drift line hits separation boundary or 0
                               ymin = c(params$Bias_M * params$Separation_M, #point where drift starts
                                        params$Drift_cil*((params$Separation_M - params$yint_cih) / params$Drift_cih) + params$yint_cil, #point where low drift is when high drift ends
                                        params$Drift_cil*((params$Separation_M - params$yint_M) / params$Drift_M) + params$yint_cil, #point where low drift is when drift ends
                                        ifelse(params$Drift_cil > 0, params$Separation_M, 0)), #point where low drift ends
                               ymax = c(params$Bias_M * params$Separation_M, #point where drift starts
                                        params$Separation_M, #point where drift ends
                                         params$Separation_M, #point where drift ends
                                        params$Separation_M),#point where drift ends
                               Condition = rep(params$Condition, 4))
    
    nd_ribbon <- data.frame(xmin = params$Non.Decision_cil,
                            xmax = params$Non.Decision_cih,
                            ymin = rep(params$Bias_cil*params$Separation_cil, 2), 
                            ymax = rep(params$Bias_cih*params$Separation_cih, 2),
                            Condition = params$Condition)
    
    sep_ribbon <- data.frame(xmin = rep(c(0), 2),
                             xmax = rep(x, 2),
                             ymin = params$Separation_cil,
                             ymax = params$Separation_cih,
                             Condition = params$Condition)
    
    df <- data.frame()
    
    p[[g + 3*(a-1)]] <- ggplot(df) + coord_cartesian(xlim = c(0, x), ylim = c(0, y)) + 
      geom_point() +  theme_bw() +
      geom_segment(data = params, 
                   aes(x = Non.Decision_M, 
                       xend = (Separation_M - yint_M) / Drift_M,
                       y = Bias_M * Separation_M, yend = Separation_M, 
                       color = Condition)) + 
      geom_rect(data = nd_ribbon,
                aes(xmin = xmin,
                    xmax = xmax,
                    ymin = ymin, 
                    ymax = ymax,
                    fill = Condition), 
                alpha=0.2) +
      geom_ribbon(data = drift_ribbon, 
                  aes(x = xvals, 
                      ymin = ymin, 
                      ymax = ymax,
                      fill = Condition), 
                  alpha=0.2) +
      geom_rect(data = sep_ribbon, 
                aes(xmin = xmin,
                    xmax = xmax,
                    ymin = ymin, 
                    ymax = ymax,
                    fill = Condition), 
                alpha=0.2) +
      geom_hline(data = params, 
                 aes(yintercept = Separation_M, color = Condition),
                 linetype = "dashed") + 
      geom_hline(yintercept = 0, linetype = "dashed") + 
      geom_vline(data = params, 
                 aes(xintercept = Non.Decision_M, color = Condition)) + 
      scale_fill_discrete(guide = FALSE) +
      scale_color_discrete(guide = FALSE) +
      xlab("Time (seconds)") + ylab(paste("Boundary \n Separation")) #+ 
      #ggtitle(paste(age[a], ",", games[g], sep = " ")) 
  } 
}

plotlist <- c(list(p[[1]], p[[4]], p[[7]], p[[10]],  
                   p[[2]], p[[5]], p[[8]], p[[11]], 
                   p[[3]], p[[6]], p[[9]], p[[12]]), ncol = 4, nrow = 3)
do.call(grid.arrange, plotlist)

Pink = control trials and green = target trials (I removed the legend to make more space)

DDM Statistics

Parameter correlations

ms.sep.adults <- sub.pars %>%
  filter(Age == "adults") %>%
  select(c(Separation, SubID, Condition, Game)) %>%
  spread(Condition, Separation)  %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.sep.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.sep.kids <- sub.pars %>%
  filter(Age != "adults") %>%
  select(c(Separation, SubID, Condition, Game)) %>%
  spread(Condition, Separation) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.sep.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.nd.adults <- sub.pars %>%
  filter(Age == "adults") %>%
  select(c(Non.Decision, SubID, Condition, Game)) %>%
  spread(Condition, Non.Decision) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.nd.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.nd.kids <- sub.pars %>%
  filter(Age != "adults") %>%
  select(c(Non.Decision, SubID, Condition, Game)) %>%
  spread(Condition, Non.Decision) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.nd.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.bias.adults <- sub.pars %>%
  filter(Age == "adults") %>%
  select(c(Bias, SubID, Condition, Game)) %>%
  spread(Condition, Bias) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.bias.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.bias.kids <- sub.pars %>%
  filter(Age != "adults") %>%
  select(c(Bias, SubID, Condition, Game)) %>%
  spread(Condition, Bias) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.bias.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.drift.adults <- sub.pars %>%
  filter(Age == "adults") %>%
  select(c(Drift, SubID, Condition, Game)) %>%
  spread(Condition, Drift) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.drift.adults, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

ms.drift.kids <- sub.pars %>%
  filter(Age != "adults") %>%
  select(c(Drift, SubID, Condition, Game)) %>%
  spread(Condition, Drift) %>%
  mutate(sdiff = scale(Target - Control)) %>%
  select(-Control, -Target) %>%
  spread(Game, sdiff)

ggpairs(data = ms.drift.kids, 
        columns = 2:4, 
        upper = list(continuous = "cor"),
        lower = list(continuous = "smooth")) + 
  theme_bw()

Adult data t-tests

sub.pars$Age <- factor(sub.pars$Age, levels = c("adults", "4", "5", "6"))
sub.pars$Condition <- factor(sub.pars$Condition)

#adult t tests
inhib.bias <- sub.pars %>%
  filter(Age == "adults", Game == "inhibition") %>%
  select(Bias, SubID, Condition) %>%
  spread(Condition, Bias)

t.test(inhib.bias$Control, inhib.bias$Target, paired = T)
## 
##  Paired t-test
## 
## data:  inhib.bias$Control and inhib.bias$Target
## t = 4.9146, df = 43, p-value = 1.338e-05
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.09938123 0.23770079
## sample estimates:
## mean of the differences 
##                0.168541
inhib.nd <- sub.pars %>%
  filter(Age == "adults", Game == "inhibition") %>%
  select(Non.Decision, SubID, Condition) %>%
  spread(Condition, Non.Decision)

t.test(inhib.nd$Control, inhib.nd$Target, paired = T)
## 
##  Paired t-test
## 
## data:  inhib.nd$Control and inhib.nd$Target
## t = -9.3618, df = 43, p-value = 6.144e-12
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1669209 -0.1077518
## sample estimates:
## mean of the differences 
##              -0.1373363
imp.sep <- sub.pars %>%
  filter(Age == "adults", Game == "implicature") %>%
  select(Separation, SubID, Condition) %>%
  spread(Condition, Separation)

t.test(imp.sep$Control, imp.sep$Target, paired = T)
## 
##  Paired t-test
## 
## data:  imp.sep$Control and imp.sep$Target
## t = 4.2129, df = 44, p-value = 0.000123
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.2223478 0.6301862
## sample estimates:
## mean of the differences 
##                0.426267
imp.drift <- sub.pars %>%
  filter(Age == "adults", Game == "implicature") %>%
  select(Drift, SubID, Condition) %>%
  spread(Condition, Drift)

t.test(imp.drift$Control, imp.drift$Target, paired = T)
## 
##  Paired t-test
## 
## data:  imp.drift$Control and imp.drift$Target
## t = 7.1506, df = 44, p-value = 6.88e-09
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.8029908 1.4332671
## sample estimates:
## mean of the differences 
##                1.118129
neg.drift <- sub.pars %>%
  filter(Age == "adults", Game == "negation") %>%
  select(Drift, SubID, Condition) %>%
  spread(Condition, Drift)

t.test(neg.drift$Control, neg.drift$Target, paired = T)
## 
##  Paired t-test
## 
## data:  neg.drift$Control and neg.drift$Target
## t = 0.80172, df = 43, p-value = 0.4271
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1117470  0.2592219
## sample estimates:
## mean of the differences 
##              0.07373745
neg.nd <- sub.pars %>%
  filter(Age == "adults", Game == "negation") %>%
  select(Non.Decision, SubID, Condition) %>%
  spread(Condition, Non.Decision)

t.test(neg.nd$Control, neg.nd$Target, paired = T)
## 
##  Paired t-test
## 
## data:  neg.nd$Control and neg.nd$Target
## t = 5.6812, df = 43, p-value = 1.062e-06
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.04892255 0.10276989
## sample estimates:
## mean of the differences 
##              0.07584622

Developmental Change across games

##Inhibition game
inhib <- filter(sub.pars, Game == "inhibition")

inhib.sep <- lm(Separation ~ Age * Condition, data = inhib)
kable(summary(inhib.sep)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.966 0.120 16.314 0.000
Age4 0.796 0.217 3.670 0.000
Age5 1.123 0.225 5.002 0.000
Age6 0.614 0.207 2.964 0.003
ConditionTarget -0.157 0.175 -0.893 0.373
Age4:ConditionTarget 0.004 0.312 0.013 0.990
Age5:ConditionTarget -0.094 0.323 -0.290 0.772
Age6:ConditionTarget -0.189 0.294 -0.644 0.520 
inhib.nd <- lm(Non.Decision ~ Age * Condition, data = inhib)
kable(summary(inhib.nd)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.322 0.029 10.956 0.000
Age4 -0.088 0.053 -1.666 0.097
Age5 0.006 0.055 0.106 0.916
Age6 0.046 0.050 0.904 0.367
ConditionTarget 0.144 0.043 3.383 0.001
Age4:ConditionTarget 0.233 0.076 3.060 0.003
Age5:ConditionTarget 0.148 0.079 1.875 0.062
Age6:ConditionTarget 0.104 0.072 1.449 0.149 
inhib.bias <- lm(Bias ~ Age * Condition, data = inhib)
kable(summary(inhib.bias)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.469 0.023 20.401 0.000
Age4 -0.059 0.041 -1.431 0.154
Age5 -0.005 0.043 -0.120 0.904
Age6 0.021 0.040 0.540 0.590
ConditionTarget -0.168 0.033 -5.030 0.000
Age4:ConditionTarget 0.162 0.060 2.721 0.007
Age5:ConditionTarget 0.046 0.062 0.740 0.460
Age6:ConditionTarget -0.083 0.056 -1.474 0.142 
inhib.drift <- lm(Drift ~ Age * Condition, data = inhib)
kable(summary(inhib.drift)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.119 0.119 26.145 0.000
Age4 -1.950 0.215 -9.084 0.000
Age5 -1.575 0.222 -7.082 0.000
Age6 -1.435 0.205 -6.995 0.000
ConditionTarget 0.328 0.174 1.888 0.060
Age4:ConditionTarget -0.280 0.309 -0.908 0.365
Age5:ConditionTarget 0.052 0.320 0.163 0.871
Age6:ConditionTarget -0.045 0.291 -0.156 0.877 
##Implicature game
imp <- filter(sub.pars, Game == "implicature")

imp.sep <- lm(Separation ~ Age * Condition, data = imp)
kable(summary(imp.sep)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.969 0.127 15.470 0.000
Age4 1.262 0.227 5.551 0.000
Age5 1.318 0.240 5.490 0.000
Age6 0.844 0.215 3.937 0.000
ConditionTarget -0.392 0.178 -2.202 0.029
Age4:ConditionTarget -0.133 0.318 -0.418 0.676
Age5:ConditionTarget -0.266 0.338 -0.787 0.432
Age6:ConditionTarget -0.088 0.307 -0.286 0.775 
imp.nd <- lm(Non.Decision ~ Age * Condition, data = imp)
kable(summary(imp.nd)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.531 0.032 16.520 0.000
Age4 -0.129 0.057 -2.249 0.026
Age5 0.265 0.061 4.371 0.000
Age6 0.147 0.054 2.709 0.007
ConditionTarget 0.002 0.045 0.036 0.971
Age4:ConditionTarget 0.176 0.080 2.184 0.030
Age5:ConditionTarget 0.020 0.086 0.239 0.811
Age6:ConditionTarget -0.050 0.077 -0.645 0.520 
imp.bias <- lm(Bias ~ Age * Condition, data = imp)
kable(summary(imp.bias)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.420 0.017 24.276 0.000
Age4 -0.006 0.031 -0.189 0.850
Age5 0.073 0.033 2.234 0.027
Age6 0.004 0.029 0.136 0.892
ConditionTarget 0.048 0.024 1.966 0.051
Age4:ConditionTarget 0.007 0.043 0.151 0.880
Age5:ConditionTarget -0.067 0.046 -1.465 0.144
Age6:ConditionTarget -0.058 0.042 -1.389 0.166 
imp.drift <- lm(Drift ~ Age * Condition, data = imp)
kable(summary(imp.drift)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.697 0.102 26.413 0.000
Age4 -1.867 0.182 -10.237 0.000
Age5 -1.406 0.193 -7.305 0.000
Age6 -1.211 0.172 -7.038 0.000
ConditionTarget -1.042 0.143 -7.295 0.000
Age4:ConditionTarget 0.723 0.255 2.834 0.005
Age5:ConditionTarget 0.554 0.271 2.042 0.042
Age6:ConditionTarget 0.502 0.246 2.043 0.042 
##Negation game
neg <- filter(sub.pars, Game == "negation")

neg.sep <- lm(Separation ~ Age * Condition, data = neg)
kable(summary(neg.sep)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.663 0.125 13.263 0.000
Age4 1.863 0.227 8.197 0.000
Age5 1.599 0.235 6.790 0.000
Age6 1.008 0.220 4.575 0.000
ConditionTarget 0.086 0.179 0.479 0.632
Age4:ConditionTarget -0.722 0.322 -2.241 0.026
Age5:ConditionTarget -0.904 0.345 -2.622 0.009
Age6:ConditionTarget -0.591 0.318 -1.863 0.064 
neg.nd <- lm(Non.Decision ~ Age * Condition , data = neg)
kable(summary(neg.nd)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.572 0.034 16.627 0.000
Age4 0.038 0.062 0.606 0.545
Age5 0.103 0.065 1.595 0.112
Age6 0.057 0.060 0.947 0.345
ConditionTarget -0.074 0.049 -1.496 0.136
Age4:ConditionTarget 0.234 0.089 2.644 0.009
Age5:ConditionTarget 0.202 0.095 2.133 0.034
Age6:ConditionTarget 0.116 0.087 1.327 0.186 
neg.bias <- lm(Bias ~ Age * Condition, data = neg)
kable(summary(neg.bias)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.477 0.017 28.288 0.000
Age4 0.059 0.031 1.943 0.053
Age5 -0.021 0.032 -0.650 0.517
Age6 -0.010 0.030 -0.331 0.741
ConditionTarget -0.049 0.024 -2.013 0.045
Age4:ConditionTarget 0.010 0.043 0.222 0.825
Age5:ConditionTarget 0.000 0.046 -0.007 0.994
Age6:ConditionTarget -0.050 0.043 -1.180 0.240 
neg.drift <- lm(Drift ~ Age * Condition, data = neg)
kable(summary(neg.drift)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.026 0.088 22.916 0.000
Age4 -1.033 0.160 -6.444 0.000
Age5 -0.352 0.166 -2.118 0.035
Age6 -0.440 0.155 -2.832 0.005
ConditionTarget -0.146 0.126 -1.153 0.250
Age4:ConditionTarget -0.550 0.227 -2.420 0.016
Age5:ConditionTarget -0.571 0.243 -2.347 0.020
Age6:ConditionTarget -0.309 0.224 -1.378 0.170

General Developmental Change

#Look at changes in paramaters in general across age: 
sep.model <- lm(Separation ~ Age, data = sub.pars)
kable(summary(sep.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.787 0.052 34.046 0
Age4 1.168 0.094 12.444 0
Age5 1.151 0.099 11.622 0
Age6 0.686 0.090 7.595 0 
nd.model <- lm(Non.Decision ~ Age, data = sub.pars)
kable(summary(nd.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.488 0.015 32.372 0.000
Age4 0.046 0.027 1.719 0.086
Age5 0.180 0.028 6.330 0.000
Age6 0.110 0.026 4.221 0.000 
bias.model <- lm(Bias ~ Age, data = sub.pars)
kable(summary(bias.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.430 0.009 49.643 0.000
Age4 0.026 0.015 1.659 0.098
Age5 0.010 0.016 0.636 0.525
Age6 -0.030 0.015 -2.023 0.043 
drift.model <- lm(Drift ~ Age, data = sub.pars)
kable(summary(drift.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 2.450 0.052 47.110 0
Age4 -1.619 0.093 -17.412 0
Age5 -1.072 0.098 -10.920 0
Age6 -0.969 0.090 -10.829 0 
#Look at continuous across age group, just children
sub.pars.cont <- filter(sub.pars, Age != "adults")
sub.pars.cont$Age <- as.numeric(as.character(sub.pars.cont$Age))

cont.sep.model <- lm(Separation ~ Age, data = sub.pars.cont)
kable(summary(cont.sep.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 4.001 0.320 12.515 0
Age -0.244 0.063 -3.907 0 
cont.nd.model <- lm(Non.Decision ~ Age, data = sub.pars.cont)
kable(summary(cont.nd.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.446 0.099 4.494 0.000
Age 0.030 0.019 1.543 0.124 
cont.bias.model <- lm(Bias ~ Age, data = sub.pars.cont)
kable(summary(cont.bias.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.572 0.048 11.811 0.000
Age -0.028 0.009 -2.969 0.003 
cont.drift.model <- lm(Drift ~ Age, data = sub.pars.cont)
kable(summary(cont.drift.model)$coefficients, digits = 3)
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.387 0.232 -1.666 0.097
Age 0.321 0.045 7.068 0.000